home *** CD-ROM | disk | FTP | other *** search
/ Suzy B Software 2 / Suzy B Software CD-ROM 2 (1994).iso / new_file / programm / basa2gfa / basica_2.gfa (.txt) next >
Encoding:
GFA-BASIC Atari  |  1995-04-25  |  10.7 KB  |  646 lines
  1. '   #############################################
  2. '      IBM PC BASICA to Atari ST GFA BASIC .LST
  3. '               conversion utility
  4. '   #############################################
  5. '            by myeck waters, 94/08/24
  6. '       This program is in the Public Domain
  7. '   #############################################
  8. '   Not to mention that it's pretty badly written
  9. '   #############################################
  10. '
  11. '   #############
  12. end$="ENDIF"+CHR$(13)+CHR$(10)
  13. go$="GOTO"
  14. pro$="PROCEDURE "
  15. begin:
  16. FILESELECT "*.bas","gwbasic.bas",a$
  17. IF a$<>""
  18.   GOTO next1
  19. ENDIF
  20. END
  21. '  ##################################
  22. '  make sure input filename has a "."
  23. '  ##################################
  24. next1:
  25. l#=LEN(a$)
  26. m#=l#
  27. loop1:
  28. IF MID$(a$,m#-1,1)="\"
  29.   GOTO next2
  30. ENDIF
  31. DEC m#
  32. GOTO loop1
  33. next2:
  34. n#=l#
  35. loop2:
  36. IF MID$(a$,n#,1)="."
  37.   GOTO next3
  38. ENDIF
  39. IF n#=0
  40.   n#=l#+1
  41.   a$=a$+"."
  42.   GOTO next3
  43. ENDIF
  44. DEC n#
  45. GOTO loop2
  46. next3:
  47. FILESELECT "*.*","output.lst",z$
  48. IF z$<>""
  49.   GOTO next4
  50. ENDIF
  51. END
  52. next4:
  53. OPEN "I",#1,a$
  54. ' #################
  55. ' set buffers, etc.
  56. ' #################
  57. size#=LOF(#1)
  58. DIM inbuf%(5+INT(size#/4))    ! input buffer
  59. DIM outbuf%(size#/2)          ! output buffer
  60. DIM numbers#(1000)            ! for line numbers that are actually
  61. DIM subs#(1000)               ! used in GOSUB, GOTO, ELSE, THEN
  62. inbuffer#=VARPTR(inbuf%(0))
  63. outbuffer#=VARPTR(outbuf%(0))
  64. atime#=TIMER/200              ! a timer
  65. ' ###################
  66. ' load BASICA file
  67. ' ###################
  68. BLOAD a$,inbuffer#
  69. PRINT
  70. inptr#=inbuffer#
  71. outptr#=outbuffer#
  72. numcount#=0
  73. ' #############################
  74. ' checking for line numbers
  75. ' after GOTO, GOSUB, THEN, ELSE
  76. ' #############################
  77. CLS
  78. PRINT
  79. PRINT "Checking for referenced line numbers:"
  80. PRINT
  81. kerser#=0
  82. i#=0
  83. search:
  84. issub#=FALSE
  85. b$=CHR$(PEEK(inbuffer#+i#))
  86. IF b$="'"             ! a REMark
  87.   GOTO foundrem
  88. ENDIF
  89. IF b$="R" OR b$="r"   ! a REMark?
  90.   GOTO checkrem
  91. ENDIF
  92. IF b$="T" OR b$="t"   ! THEN?
  93.   GOTO checkthen
  94. ENDIF
  95. IF b$="G" OR b$="g"   ! GOTO or GOSUB?
  96.   GOTO checkgo
  97. ENDIF
  98. IF b$="E" OR b$="e"   ! ELSE?
  99.   GOTO checkelse
  100. ENDIF
  101. INC i#
  102. IF i#<size#
  103.   GOTO search
  104. ENDIF
  105. GOTO convert
  106. ' #############
  107. ' check for REM
  108. ' #############
  109. checkrem:
  110. INC i#
  111. b$=CHR$(PEEK(inbuffer#+i#))
  112. IF b$<>"E" AND b$<>"e"
  113.   GOTO search
  114. ENDIF
  115. INC i#
  116. b$=CHR$(PEEK(inbuffer#+i#))
  117. IF b$<>"M" AND b$<>"m"
  118.   GOTO search
  119. ENDIF
  120. ' ############################################
  121. ' found a REM, nothing to check 'til next line
  122. ' ############################################
  123. foundrem:
  124. fr2:
  125. INC i#
  126. IF i#=>size#
  127.   GOTO convert
  128. ENDIF
  129. IF PEEK(inbuffer#+i#)<>13         ! CHR$(13) = <CR>
  130.   GOTO fr2
  131. ENDIF
  132. GOTO search
  133. ' ##############
  134. ' check for THEN
  135. ' ##############
  136. checkthen:
  137. INC i#
  138. b$=CHR$(PEEK(inbuffer#+i#))
  139. IF b$<>"H" AND b$<>"h"
  140.   GOTO search
  141. ENDIF
  142. INC i#
  143. b$=CHR$(PEEK(inbuffer#+i#))
  144. IF b$<>"E" AND b$<>"e"
  145.   GOTO search
  146. ENDIF
  147. INC i#
  148. b$=CHR$(PEEK(inbuffer#+i#))
  149. IF b$<>"N" AND b$<>"n"
  150.   GOTO search
  151. ENDIF
  152. GOTO checknum
  153. ' ##############
  154. ' check for ELSE
  155. ' ##############
  156. checkelse:
  157. INC i#
  158. b$=CHR$(PEEK(inbuffer#+i#))
  159. IF b$<>"L" AND b$<>"l"
  160.   GOTO search
  161. ENDIF
  162. INC i#
  163. b$=CHR$(PEEK(inbuffer#+i#))
  164. IF b$<>"S" AND b$<>"s"
  165.   GOTO search
  166. ENDIF
  167. INC i#
  168. b$=CHR$(PEEK(inbuffer#+i#))
  169. IF b$<>"E" AND b$<>"e"
  170.   GOTO search
  171. ENDIF
  172. GOTO checknum
  173. ' #######################
  174. ' check for GOSUB or GOTO
  175. ' #######################
  176. checkgo:
  177. INC i#
  178. b$=CHR$(PEEK(inbuffer#+i#))
  179. IF b$<>"O" AND b$<>"o"
  180.   GOTO search
  181. ENDIF
  182. INC i#
  183. b$=CHR$(PEEK(inbuffer#+i#))
  184. IF b$="S" OR b$="s"
  185.   GOTO checksub
  186. ENDIF
  187. IF b$<>"T" AND b$<>"t"
  188.   GOTO search
  189. ENDIF
  190. INC i#
  191. b$=CHR$(PEEK(inbuffer#+i#))
  192. IF b$<>"O" AND b$<>"o"
  193.   GOTO search
  194. ENDIF
  195. GOTO checknum
  196. ' ###############
  197. ' check for GOSUB
  198. ' ###############
  199. checksub:
  200. INC i#
  201. b$=CHR$(PEEK(inbuffer#+i#))
  202. IF b$<>"U" AND b$<>"u"
  203.   GOTO search
  204. ENDIF
  205. INC i#
  206. b$=CHR$(PEEK(inbuffer#+i#))
  207. IF b$<>"B" AND b$<>"b"
  208.   GOTO search
  209. ENDIF
  210. issub#=TRUE      ! the GOSUB flag
  211. ' #####################
  212. ' look for line numbers
  213. ' #####################
  214. checknum:
  215. num$=""
  216. cn1:
  217. INC i#
  218. IF i#=>size#
  219.   GOTO convert
  220. ENDIF
  221. b$=CHR$(PEEK(inbuffer#+i#))
  222. IF b$=CHR$(13)
  223.   GOTO search
  224. ENDIF
  225. IF b$=" "
  226.   GOTO cn1
  227. ENDIF
  228. IF b$>"/" AND b$<":"
  229.   GOTO cn2
  230. ENDIF
  231. GOTO search
  232. ' ##################
  233. ' found line numbers
  234. ' ##################
  235. cn2:
  236. num$=""
  237. cn3:
  238. num$=num$+b$
  239. INC i#
  240. IF i#=>size#
  241.   GOSUB numend
  242.   GOTO search
  243. ENDIF
  244. b$=CHR$(PEEK(inbuffer#+i#))
  245. IF b$>"/" AND b$<":"
  246.   GOTO cn3
  247. ENDIF
  248. IF b$=","  !  commas always mean more line numbers(?)
  249.   GOSUB numend
  250.   INC i#
  251.   b$=CHR$(PEEK(inbuffer#+i#))
  252.   GOTO cn2
  253. ENDIF
  254. GOSUB numend
  255. GOTO search
  256. ' ##############
  257. PROCEDURE numend
  258.   IF VAL(num$)
  259.     IF numcount#=0
  260.       numbers#(numcount#)=VAL(num$)
  261.       PRINT num$;"   ";
  262.       kerser#=kerser#+10
  263.       IF issub#
  264.         subs#(numcount#)=TRUE
  265.       ELSE
  266.         subs#(numcount#)=FALSE
  267.       ENDIF
  268.       INC numcount#
  269.     ELSE
  270.       match#=FALSE
  271.       FOR j#=0 TO numcount#
  272.         IF VAL(num$)=numbers#(j#)
  273.           match#=TRUE
  274.         ENDIF
  275.       NEXT j#
  276.       IF match#=FALSE
  277.         numbers#(numcount#)=VAL(num$)
  278.         HTAB kerser#+1
  279.         PRINT num$;
  280.         kerser#=kerser#+10
  281.         IF kerser#>70
  282.           kerser#=0
  283.           PRINT
  284.         ENDIF
  285.         IF issub#
  286.           subs#(numcount#)=TRUE
  287.         ELSE
  288.           subs#(numcount#)=FALSE
  289.         ENDIF
  290.         INC numcount#
  291.       ENDIF
  292.     ENDIF
  293.   ENDIF
  294. RETURN
  295. ' ###############
  296. ' converting text
  297. ' ###############
  298. convert:
  299. PRINT
  300. PRINT
  301. PRINT "converting lines: "
  302. PRINT
  303. counter#=0
  304. i#=0
  305. o#=0
  306. ' ###############
  307. ' begin next line
  308. ' ###############
  309. nextline:
  310. PRINT ".";
  311. IF counter#>999
  312.   temp#=FRE(0)
  313.   counter#=0
  314. ENDIF
  315. foundif#=FALSE
  316. foundcom#=FALSE
  317. inquotes#=FALSE
  318. issub#=FALSE
  319. line$=""
  320. findline:
  321. b#=PEEK(inbuffer#+i#)
  322. IF b#<47 OR b#>58
  323.   INC i#
  324.   GOTO findline
  325. ENDIF
  326. ' ###############
  327. findline2:
  328. b$=CHR$(PEEK(inbuffer#+i#))
  329. IF b$>"/" AND b$<":"
  330.   line$=line$+b$
  331.   INC i#
  332.   GOTO findline2
  333. ENDIF
  334. line#=VAL(line$)
  335. match#=FALSE
  336. FOR j#=0 TO numcount#
  337.   IF line#=numbers#(j#)
  338.     match#=TRUE
  339.     IF subs#(j#)
  340.       issub#=TRUE
  341.     ENDIF
  342.   ENDIF
  343. NEXT j#
  344. IF match#
  345.   IF issub#
  346.     FOR j#=1 TO LEN(pro$)
  347.       POKE outbuffer#+o#,ASC(MID$(pro$,j#,1))
  348.       INC o#
  349.     NEXT j#
  350.   ENDIF
  351.   FOR j#=1 TO LEN(line$)
  352.     POKE outbuffer#+o#,ASC(MID$(line$,j#,1))
  353.     INC o#
  354.   NEXT j#
  355.   IF issub#=FALSE
  356.     POKE outbuffer#+o#,58
  357.     INC o#
  358.   ENDIF
  359.   POKE outbuffer#+o#,13
  360.   INC o#
  361.   POKE outbuffer#+o#,10
  362.   INC o#
  363. ENDIF
  364. ' GOTO nextchar
  365. ' ###############################
  366. ' check for leading REM or ' or !
  367. ' ###############################
  368. leadrem:
  369. b$=CHR$(PEEK(inbuffer#+i#))
  370. IF b$="'"
  371.   GOTO moverem
  372. ENDIF
  373. IF b$=" "
  374.   INC i#
  375.   GOTO leadrem
  376. ENDIF
  377. IF b$<>"R" AND b$<>"r"
  378.   GOTO nextchar
  379. ENDIF
  380. b$=CHR$(PEEK(inbuffer#+i#+1))
  381. IF b$<>"E" AND b$<>"e"
  382.   GOTO nextchar
  383. ENDIF
  384. b$=CHR$(PEEK(inbuffer#+i#+2))
  385. IF b$<>"M" AND b$<>"m"
  386.   GOTO nextchar
  387. ENDIF
  388. ' ######################
  389. ' it's a REM, so move it
  390. ' ######################
  391. moverem:
  392. b#=PEEK(inbuffer#+i#)
  393. POKE outbuffer#+o#,b#
  394. INC i#
  395. INC o#
  396. IF b#=13
  397.   DEC o#
  398.   IF foundif#
  399.     byte#=b#
  400.     DEC i#
  401.     GOTO iscr
  402.   ENDIF
  403.   GOSUB crpoke
  404.   GOTO nextline
  405. ENDIF
  406. GOTO moverem
  407. ' ####################
  408. ' check next character
  409. ' ####################
  410. nextchar:
  411. IF i#=>size#
  412.   GOTO finis
  413. ENDIF
  414. byte#=PEEK(inbuffer#+i#)
  415. ' #######################
  416. ' is it a quote mark (")?
  417. ' #######################
  418. IF byte#=34
  419.   IF inquotes#
  420.     inquotes#=FALSE
  421.   ELSE
  422.     inquotes#=TRUE
  423.   ENDIF
  424.   POKE outbuffer#+o#,byte#
  425.   INC o#
  426.   INC i#
  427.   GOTO nextchar
  428. ENDIF
  429. ' ####################################
  430. ' an apostrophe'd REM after a command?
  431. ' ####################################
  432. IF byte#=39 AND inquotes#=FALSE
  433.   POKE outbuffer#+o#,33
  434.   INC o#
  435.   INC i#
  436.   GOTO moverem
  437. ENDIF
  438. IF byte#=58 AND inquotes#=FALSE
  439.   '  POKE outbuffer+o,13
  440.   '  INC o
  441.   '  POKE outbuffer+o,10
  442.   '  INC o
  443.   '  INC i
  444.   GOSUB crpoke
  445.   foundcom#=FALSE
  446.   '  foundif=FALSE
  447.   GOTO nextchar
  448. ENDIF
  449. ' ##########################
  450. ' an actual carriage retuen?
  451. ' ##########################
  452. iscr:
  453. IF byte#=13
  454.   GOSUB crpoke
  455.   INC i#
  456.   IF foundif#
  457.     WHILE foundif#
  458.       FOR j#=1 TO LEN(end$)
  459.         POKE outbuffer#+o#,ASC(MID$(end$,j#,1))
  460.         INC o#
  461.       NEXT j#
  462.       DEC foundif#
  463.     WEND
  464.   ENDIF
  465.   GOTO nextline
  466. ENDIF
  467. IF foundcom#=FALSE
  468.   IF CHR$(byte#)="I" OR CHR$(byte#)="i"
  469.     foundcom#=TRUE
  470.     POKE outbuffer#+o#,byte#
  471.     INC o#
  472.     INC i#
  473.     byte#=PEEK(inbuffer#+i#)
  474.     IF CHR$(byte#)="F" OR CHR$(byte#)="f"
  475.       foundif#=foundif#+1
  476.       POKE outbuffer#+o#,byte#
  477.       INC o#
  478.       INC i#
  479.       GOTO nextchar
  480.     ENDIF
  481.   ENDIF
  482. ENDIF
  483. ' ###########################################
  484. ' looking for THEN, GOSUB or GOTO after an IF
  485. ' ###########################################
  486. IF foundif# !AND foundcom
  487.   b$=CHR$(byte#)
  488.   IF b$="T" OR b$="t"
  489.     GOTO ckit
  490.   ENDIF
  491.   IF b$="G" OR b$="g"
  492.     GOTO ckig
  493.   ENDIF
  494.   IF b$="E" OR b$="e"
  495.     GOTO ckie
  496.   ENDIF
  497. ENDIF
  498. ' ##############################
  499. ' copy character and go for next
  500. ' ##############################
  501. POKE outbuffer#+o#,byte#
  502. INC i#
  503. INC o#
  504. GOTO nextchar
  505. ' ################################
  506. ' ################################
  507. ' ##############
  508. ' check for THEN
  509. ' ##############
  510. ckit:
  511. IF CHR$(PEEK(inbuffer#+i#+1))<>"H" AND CHR$(PEEK(inbuffer#+i#+1))<>"h"
  512.   GOTO ckng
  513. ENDIF
  514. IF CHR$(PEEK(inbuffer#+i#+2))<>"E" AND CHR$(PEEK(inbuffer#+i#+2))<>"e"
  515.   GOTO ckng
  516. ENDIF
  517. IF CHR$(PEEK(inbuffer#+i#+3))<>"N" AND CHR$(PEEK(inbuffer#+i#+3))<>"n"
  518.   GOTO ckng
  519. ENDIF
  520. i#=i#+3
  521. GOSUB crpoke
  522. ' ################################
  523. ' check if THEN followed by line #
  524. ' ################################
  525. ckit1:
  526. j#=i#+1
  527. ckit2:
  528. b2#=PEEK(inbuffer#+j#)
  529. IF b2#=32
  530.   INC j#
  531.   GOTO ckit2
  532. ENDIF
  533. IF b2#>47 AND b2#<58
  534.   FOR j#=1 TO LEN(go$)
  535.     POKE outbuffer#+o#,ASC(MID$(go$,j#,1))
  536.     INC o#
  537.   NEXT j#
  538. ENDIF
  539. GOTO nextchar
  540. ' #####################
  541. ' ELSE following an IF?
  542. ' #####################
  543. ckie:
  544. IF CHR$(PEEK(inbuffer#+i#+1))<>"L" AND CHR$(PEEK(inbuffer#+i#+1))<>"l"
  545.   GOTO ckng
  546. ENDIF
  547. IF CHR$(PEEK(inbuffer#+i#+2))<>"S" AND CHR$(PEEK(inbuffer#+i#+2))<>"s"
  548.   GOTO ckng
  549. ENDIF
  550. IF CHR$(PEEK(inbuffer#+i#+3))<>"E" AND CHR$(PEEK(inbuffer#+i#+3))<>"e"
  551.   GOTO ckng
  552. ENDIF
  553. GOSUB crpoke
  554. DEC i#
  555. FOR j#=1 TO 4
  556.   POKE outbuffer#+o#,PEEK(inbuffer#+i#)
  557.   INC o#
  558.   INC i#
  559. NEXT j#
  560. GOSUB crpoke
  561. DEC i#
  562. GOTO ckit1
  563. ' ########################
  564. ' check for GOSUB and GOTO
  565. ' ########################
  566. ckig:
  567. IF CHR$(PEEK(inbuffer#+i#+1))<>"O" AND CHR$(PEEK(inbuffer#+i#+1))<>"o"
  568.   GOTO ckng
  569. ENDIF
  570. IF CHR$(PEEK(inbuffer#+i#+2))="S" OR CHR$(PEEK(inbuffer#+i#+2))="s"
  571.   GOTO cksub
  572. ENDIF
  573. IF CHR$(PEEK(inbuffer#+i#+2))<>"T" AND CHR$(PEEK(inbuffer#+i#+2))<>"t"
  574.   GOTO ckng
  575. ENDIF
  576. IF CHR$(PEEK(inbuffer#+i#+3))<>"O" AND CHR$(PEEK(inbuffer#+i#+3))<>"o"
  577.   GOTO ckng
  578. ENDIF
  579. GOSUB crpoke
  580. POKE outbuffer#+o#,ASC(b$)
  581. INC o#
  582. GOTO nextchar
  583. cksub:
  584. IF CHR$(PEEK(inbuffer#+i#+3))<>"U" AND CHR$(PEEK(inbuffer#+i#+3))<>"u"
  585.   GOTO ckng
  586. ENDIF
  587. IF CHR$(PEEK(inbuffer#+i#+4))<>"B" AND CHR$(PEEK(inbuffer#+i#+4))<>"b"
  588.   GOTO ckng
  589. ENDIF
  590. GOSUB crpoke
  591. POKE outbuffer#+o#,ASC(b$)
  592. INC o#
  593. GOTO nextchar
  594. ' ######################
  595. ' Not a match so keep on
  596. ' ######################
  597. ckng:
  598. POKE outbuffer#+o#,byte#
  599. INC o#
  600. INC i#
  601. GOTO nextchar
  602. ' ########################
  603. ' add a line feed
  604. ' #######################
  605. PROCEDURE crpoke
  606.   POKE outbuffer#+o#,13
  607.   INC o#
  608.   POKE outbuffer#+o#,10
  609.   INC o#
  610.   INC i#
  611.   foundcom#=FALSE
  612. RETURN
  613. ' #########
  614. ' finish up
  615. ' ##########
  616. finis:
  617. CLOSE #1
  618. POKE outbuffer#+o#,13
  619. INC o#
  620. POKE outbuffer#+o#,10
  621. INC o#
  622. BSAVE z$,outbuffer#,o#+1
  623. PRINT
  624. PRINT "done."
  625. btime#=1+INT((TIMER/200)-atime#)
  626. ctime#=INT(btime#/60)
  627. btime#=btime#-(ctime#*60)
  628. PRINT
  629. PRINT "Conversion time:"
  630. PRINT "   ";
  631. IF ctime#
  632.   PRINT ctime#;" minute";
  633.   IF ctime#>1
  634.     PRINT "s";
  635.   ENDIF
  636.   PRINT ", ";
  637. ENDIF
  638. PRINT btime#;" second";
  639. IF btime#>1
  640.   PRINT "s";
  641. ENDIF
  642. PRINT "."
  643. ALERT 0,"all done",1,"ok",g#
  644. EDIT
  645. ' ####################
  646.